home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / mac / mouse.el < prev    next >
Encoding:
Text File  |  1994-01-18  |  2.7 KB  |  85 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993, 1994 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; GNU Emacs is distributed in the hope that it will be useful,
  6. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  7. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  8. ;;; GNU General Public License for more details.
  9. ;;;
  10.  
  11. ;;;
  12. ;;; Mouse support.  These are straight from x-mouse.el.
  13. ;;;
  14.  
  15. (defun x-mouse-select (arg)
  16.   "Select Emacs window the mouse is on."
  17.   (let ((start-w (selected-window))
  18.     (done nil)
  19.     (w (selected-window))
  20.     (rel-coordinate nil))
  21.     (while (and (not done)
  22.         (null (setq rel-coordinate
  23.                 (coordinates-in-window-p arg w))))
  24.       (setq w (next-window w))
  25.       (if (eq w start-w)
  26.       (setq done t)))
  27.     (select-window w)
  28.     rel-coordinate))
  29.  
  30. (defun x-mouse-set-point (arg)
  31.   "Select Emacs window mouse is on, and move point to mouse position."
  32.   (let* ((relative-coordinate (x-mouse-select arg))
  33.      margin-column
  34.      (rel-x (car relative-coordinate))
  35.      (rel-y (car (cdr relative-coordinate))))
  36.     (if relative-coordinate
  37.     (let ((prompt-width (if (eq (selected-window) (minibuffer-window))
  38.                 minibuffer-prompt-width 0)))
  39.       (move-to-window-line rel-y)
  40.       (if (eobp)
  41.           ;; If text ends before the desired line,
  42.           ;; always position at end of that line.
  43.           nil
  44.         (setq margin-column
  45.           (if (or truncate-lines (> (window-hscroll) 0))
  46.               (current-column)
  47.             ;; If we are using line continuation,
  48.             ;; compensate if first character on a continuation line
  49.             ;; does not start precisely at the margin.
  50.             (- (current-column)
  51.                (% (current-column) (1- (window-width))))))
  52.         (move-to-column (+ rel-x (1- (max 1 (window-hscroll)))
  53.                    (if (= (point) 1)
  54.                    (- prompt-width) 0)
  55.                    margin-column)))))))
  56.  
  57. (defun x-mouse-set-mark (arg)
  58.   "Select Emacs window mouse is on, and set mark at mouse position.
  59. Display cursor at that position for a second."
  60.   (if (x-mouse-select arg)
  61.       (let ((point-save (point)))
  62.     (unwind-protect
  63.         (progn (x-mouse-set-point arg)
  64.            (push-mark nil t)
  65.            (sit-for 1))
  66.       (goto-char point-save)))))
  67.  
  68.  
  69. ;;; This was originally hand-coded in C.  I wonder why.
  70. (defun coordinates-in-window-p (positions window)
  71.   "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
  72. Returned value is list of positions expressed\n\
  73. relative to window upper left corner."
  74.   (let* ((xcoord (nth 0 positions))
  75.      (ycoord (nth 1 positions))
  76.      (edges (window-edges window))
  77.      (left (nth 0 edges))
  78.      (top (nth 1 edges))
  79.      (right (nth 2 edges))
  80.      (bottom (nth 3 edges)))
  81.     (if (or (< xcoord left) (>= xcoord (1- right))
  82.         (< ycoord top) (>= ycoord (1- bottom)))
  83.     nil
  84.       (list (- xcoord left) (- ycoord top)))))
  85.